perm filename DUMPEM.SAI[1,KMC] blob
sn#006428 filedate 1972-08-16 generic text, type T, neo UTF8
00100 BEGIN "DUMPEM"
00200 INTEGER ARRAY HSTBUF[0:127];
00300 INTEGER ARRAY DRCTRY[0:127];
00400 INTEGER GAME,HR,MIN,SEC,LASTGAME,DENT,HENT,D,H,FLAG;
00500 INTEGER DATE,OLDDATE,NORMAL,TIME,CHAR,IGNORE,NOCHARS;
00550 INTEGER DATEMASK,TIMEMASK,DAY,MO,YR;
00600 STRING FILNAM,EFFECTIVE;
00700 LABEL GETNAM;
00800 DEFINE CRLF="13&10";
00900 DEFINE HSTCHN="11";
01000 DEFINE RPTCHN="10";
01100 DEFINE FORMDATE="
01200 START_CODE
01300 MOVE '15,DENT;
01400 AND '15,DATEMASK;
01500 MOVEM '15,DATE;
01600 END";
01700 DEFINE FORMNORM="
01800 QUICK_CODE
01900 MOVE '15,DENT;
02000 LSH '15,-35;
02100 MOVEM '15,NORMAL;
02200 END";
02300 DEFINE SPLITENT="
02400 START_CODE
02500 MOVE '15,HENT;
02600 MOVE '14,'15;
02700 AND '14,TIMEMASK;
02800 MOVEM '14,TIME;
02900 MOVE '14,'15;
03000 LSH '14,-24;
03050 MOVE '13,'14;
03100 ANDI '14,'17;
03200 MOVEM '14,GAME;
03210 LSH '13,-4;
03215 ANDI '13,1;
03220 MOVEM '13,IGNORE;
03300 LSH '15,-29;
03350 SUBI '15,'40;
03400 MOVEM '15,CHAR;
03500 END";
03550 DATE←OLDDATE←0;
03555 NORMAL←1;
03560 DATEMASK←'007777777777;
03570 TIMEMASK←'000077777777;
03600 GETNAM: OUTSTR(CRLF & "TYPE THE CHILD'S NAME, THEN CARRIAGE RETURN: ");
03800 FILNAM←INCHWL;
03900 OPEN(HSTCHN,"DSK",15,0,0,0,0,0);
04000 LOOKUP(HSTCHN,FILNAM&".HST[1,KMC]",FLAG);
04100 IF FLAG THEN BEGIN
04200 OUTSTR("FILE "&FILNAM&".HST [1,KMC] NOT FOUND");
04300 RELEASE(HSTCHN);
04400 GOTO GETNAM;
04500 END;
04600 OPEN(RPTCHN,"DSK",0,0,2,0,0,0);
04700 ENTER(RPTCHN,FILNAM&".RPT",FLAG);
04800 ARRYIN(HSTCHN,DRCTRY[0],128);
04900 D←1;
05000 WHILE DRCTRY[D]≠0 LAND D<128 OR DRCTRY[D+1]≠0 LAND D<128 DO BEGIN
05100 DENT←DRCTRY[D];
05200 D←D+1;
05300 FORMDATE;
05400 IF DATE≠OLDDATE THEN BEGIN
05450 IF OLDDATE≠0 THEN BEGIN
05500 OUT(RPTCHN,"END OF SESSION"&CRLF&CRLF&CRLF);
05550 IF NORMAL THEN OUT(RPTCHN,
05560 "SESSION ENDED NORMALLY"&CRLF)
05565 ELSE OUT(RPTCHN,
05567 "SYSTEM CRASHED"&CRLF);
05570 END;
05575 DAY←(DATE MOD 31)+1;
05580 MO←((DATE DIV 31)MOD 12)+1;
05585 YR←((DATE DIV 31)DIV 12)+64;
05600 OUT(RPTCHN,"SESSION OF "&CVS(MO)&"/"&CVS(DAY)&"/"
05605 &CVS(YR)&CRLF&CRLF);
05700 END;
05900 FORMNORM;
05950 IF DATE=OLDDATE AND ¬NORMAL THEN
05975 OUT(RPTCHN,CRLF&"SYSTEM CRASHED"&CRLF);
06000 OLDDATE←DATE;
06100 ARRYIN(HSTCHN,HSTBUF[0],128);
06200 NOCHARS←HSTBUF[0] MOD '1000000;
06300 FOR H←1 STEP 1 UNTIL NOCHARS DO BEGIN
06400 HENT←HSTBUF[H];
06600 SPLITENT;
06700 TIME←TIME DIV 60;
06800 SEC←TIME MOD 60;
06900 MIN←(TIME DIV 60)MOD 60;
07000 HR←TIME DIV 3600;
07010 IF ¬IGNORE THEN EFFECTIVE←"EFFECTIVE"
07020 ELSE EFFECTIVE←" ";
07100 IF GAME ≠ LASTGAME THEN OUT(RPTCHN,CRLF);
07200 OUT(RPTCHN,CVS(GAME)&" "&CVXSTR(CHAR)&" "&CVS(HR)
07300 &":"&CVS(MIN)&":"&CVS(SEC)&" "&EFFECTIVE&CRLF);
07400 LASTGAME←GAME;
07500 END;
07600 END;
07650 IF ¬NORMAL THEN OUT(RPTCHN,CRLF&"SYSTEM CRASHED"&CRLF);
07700 OUT(RPTCHN,"END OF LAST SESSION");
07800 RELEASE(RPTCHN);
07900 RELEASE(HSTCHN);
07950 OUTSTR("REPORT IS ON "&FILNAM&".RPT"&CRLF);
08000 END "DUMPEM";